Usenet 1993 July/InfoMagic USENET CD-ROM July 1993.ISO/sources/unix/volume13/m4/part01

Internet Message Format | 1988-02-27 | 59.8 KB

Subject:  v13i038:  Public domain M4 macro processor, Part01/02
Newsgroups: comp.sources.unix
Sender: sources
Approved: [e-mail]

Submitted-by: Ozan Yigit <yunexus!oz>
Posting-number: Volume 13, Issue 38
Archive-name: m4/part01


#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#    makefile
#    mdef.h
#    extr.h
#    main.c
#    eval.c
#    serv.c
#    look.c
#    misc.c
#    expr.c
export PATH; PATH=/bin:$PATH
echo shar: extracting "'makefile'" '(1372 characters)'
if test -f 'makefile'
then
    echo shar: will not over-write existing file "'makefile'"
else
sed 's/^    X//' << \SHAR_EOF > 'makefile'
    X#
    X# pd m4    [oz]
    X#
    X#    -DEXTENDED
    X#        if you like to get paste & spaste macros.
    X#    -DVOID
    X#        if your C compiler does NOT support void.
    X#    -DGETOPT
    X#        if you STILL do not have getopt    in your library.
    X#        [This means your library is broken. Fix it.]
    X#    -DDUFFCP
    X#        if you do not have fast memcpy in your library.
    X#
    XCFLAGS = -O -DEXTENDED
    XDEST =  /usr/local/bin
    XMANL =     /usr/man/manl
    XOBJS =  main.o eval.o serv.o look.o misc.o expr.o
    XCSRC =  main.c eval.c serv.c look.c misc.c expr.c
    XINCL =  mdef.h extr.h
    XMSRC =  ack.m4 hanoi.m4 hash.m4 sqroot.m4 string.m4 test.m4
    XDOCS =    README MANIFEST m4.1
    X
    XMBIN = /usr/bin
    X
    Xm4: ${OBJS}
    X    @echo "loading m4.."
    X    @cc -s -o m4 ${OBJS}
    X    @size m4
    X
    X${OBJS}: ${INCL}
    X
    Xlint:
    X    lint -h ${CSRC}
    X
    Xinstall: m4
    X    install ./m4 ${DEST}/m4
    X    cp ./m4.1 ${MANL}/m4.l
    X
    Xdeinstall:
    X    rm -f ${DEST}/m4
    X    rm -f ${MANL}/m4.l
    Xtime: m4
    X    @echo "timing comparisons.."
    X    @echo "un*x m4:"
    X    time ${MBIN}/m4 <test.m4 >unxm4.out
    X    @echo "pd m4:"
    X    time ./m4 <test.m4 >pdm4.out
    X    @echo "un*x m4:"
    X    time ${MBIN}/m4 <test.m4 >unxm4.out
    X    @echo "pd m4:"
    X    time ./m4 <test.m4 >pdm4.out
    X    @echo "un*x m4:"
    X    time ${MBIN}/m4 <test.m4 >unxm4.out
    X    @echo "pd m4:"
    X    time ./m4 <test.m4 >pdm4.out
    X    @echo "output comparisons.."
    X    -diff pdm4.out unxm4.out
    X    @rm -f pdm4.out unxm4.out
    Xclean:
    X    rm -f *.o core m4 *.out
    Xpack:
    X    shar -a makefile ${INCL} ${CSRC} >M4MAIN.SHAR
    X    shar -a ${MSRC} ${DOCS} >M4MSRC.SHAR
SHAR_EOF
if test 1372 -ne "`wc -c < 'makefile'`"
then
    echo shar: error transmitting "'makefile'" '(should have been 1372 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'mdef.h'" '(4711 characters)'
if test -f 'mdef.h'
then
    echo shar: will not over-write existing file "'mdef.h'"
else
sed 's/^    X//' << \SHAR_EOF > 'mdef.h'
    X/*
    X * mdef.h
    X * Facility: m4 macro processor
    X * by: oz
    X */
    X
    X
    X#ifndef unix
    X#define unix 0
    X#endif
    X
    X#ifndef vms
    X#define vms 0
    X#endif
    X
    X#if vms
    X
    X#include stdio
    X#include ctype
    X#include signal
    X
    X#else
    X
    X#include <stdio.h>
    X#include <ctype.h>
    X#include <signal.h>
    X
    X#endif
    X
    X/*
    X *
    X * m4 constants..
    X *
    X */
    X
    X#define MACRTYPE        1
    X#define DEFITYPE        2
    X#define EXPRTYPE        3
    X#define SUBSTYPE        4
    X#define IFELTYPE        5
    X#define LENGTYPE        6
    X#define CHNQTYPE        7
    X#define SYSCTYPE        8
    X#define UNDFTYPE        9
    X#define INCLTYPE        10
    X#define SINCTYPE        11
    X#define PASTTYPE        12
    X#define SPASTYPE        13
    X#define INCRTYPE        14
    X#define IFDFTYPE        15
    X#define PUSDTYPE        16
    X#define POPDTYPE        17
    X#define SHIFTYPE        18
    X#define DECRTYPE        19
    X#define DIVRTYPE        20
    X#define UNDVTYPE        21
    X#define DIVNTYPE        22
    X#define MKTMTYPE        23
    X#define ERRPTYPE        24
    X#define M4WRTYPE        25
    X#define TRNLTYPE        26
    X#define DNLNTYPE        27
    X#define DUMPTYPE        28
    X#define CHNCTYPE        29
    X#define INDXTYPE        30
    X#define SYSVTYPE        31
    X#define EXITTYPE        32
    X#define DEFNTYPE        33
    X
    X#define STATIC          128
    X
    X/*
    X * m4 special characters
    X */
    X
    X#define ARGFLAG         '$'
    X#define LPAREN          '('
    X#define RPAREN          ')'
    X#define LQUOTE          '`'
    X#define RQUOTE          '\''
    X#define COMMA           ','
    X#define SCOMMT          '#'
    X#define ECOMMT          '\n'
    X
    X/*
    X * definitions of diversion files. If the name of
    X * the file is changed, adjust UNIQUE to point to the
    X * wildcard (*) character in the filename.
    X */
    X
    X#if unix
    X#define DIVNAM  "/tmp/m4*XXXXXX"        /* unix diversion files    */
    X#define UNIQUE          7               /* unique char location    */
    X#else
    X#if vms
    X#define DIVNAM  "sys$login:m4*XXXXXX"   /* vms diversion files     */
    X#define UNIQUE          12              /* unique char location    */
    X#else
    X#define DIVNAM    "\M4*XXXXXX"        /* msdos diversion files   */
    X#define    UNIQUE        3            /* unique char location    */
    X#endif
    X#endif
    X
    X/*
    X * other important constants
    X */
    X
    X#define EOS             (char) 0
    X#define MAXINP          10              /* maximum include files   */
    X#define MAXOUT          10              /* maximum # of diversions */
    X#define MAXSTR          512             /* maximum size of string  */
    X#define BUFSIZE         4096            /* size of pushback buffer */
    X#define STACKMAX        1024            /* size of call stack      */
    X#define STRSPMAX        4096            /* size of string space    */
    X#define MAXTOK          MAXSTR          /* maximum chars in a tokn */
    X#define HASHSIZE        199             /* maximum size of hashtab */
    X
    X#define ALL             1
    X#define TOP             0
    X
    X#define TRUE            1
    X#define FALSE           0
    X#define cycle           for(;;)
    X
    X#ifdef VOID
    X#define void            int             /* define if void is void. */
    X#endif
    X
    X/*
    X * m4 data structures
    X */
    X
    Xtypedef struct ndblock *ndptr;
    X
    Xstruct ndblock {                /* hastable structure         */
    X        char    *name;          /* entry name..               */
    X        char    *defn;          /* definition..               */
    X        int     type;           /* type of the entry..        */
    X        ndptr   nxtptr;         /* link to next entry..       */
    X};
    X
    X#define nil     ((ndptr) 0)
    X
    Xstruct keyblk {
    X        char    *knam;          /* keyword name */
    X        int     ktyp;           /* keyword type */
    X};
    X
    Xtypedef union {            /* stack structure */
    X    int    sfra;        /* frame entry  */
    X    char     *sstr;        /* string entry */
    X} stae;
    X
    X/*
    X * macros for readibility and/or speed
    X *
    X *      gpbc()  - get a possibly pushed-back character
    X *      min()   - select the minimum of two elements
    X *      pushf() - push a call frame entry onto stack
    X *      pushs() - push a string pointer onto stack
    X */
    X#define gpbc()      (bp > buf) ? *--bp : getc(infile[ilevel])
    X#define min(x,y) ((x > y) ? y : x)
    X#define pushf(x) if (sp < STACKMAX) mstack[++sp].sfra = (x)
    X#define pushs(x) if (sp < STACKMAX) mstack[++sp].sstr = (x)
    X
    X/*
    X *        .                   .
    X *    |   .    |  <-- sp        |  .  |
    X *    +-------+            +-----+
    X *    | arg 3 ----------------------->| str |
    X *    +-------+            |  .  |
    X *    | arg 2 ---PREVEP-----+        .
    X *    +-------+          |
    X *        .              |        |     |
    X *    +-------+          |     +-----+
    X *    | plev    |  PARLEV     +-------->| str |
    X *    +-------+            |  .  |
    X *    | type    |  CALTYP           .
    X *    +-------+
    X *    | prcf    ---PREVFP--+
    X *    +-------+         |
    X *    |   .    |  PREVSP  |
    X *        .              |
    X *    +-------+       |
    X *    |    <----------+
    X *    +-------+
    X *
    X */
    X#define PARLEV  (mstack[fp].sfra)
    X#define CALTYP  (mstack[fp-1].sfra)
    X#define PREVEP    (mstack[fp+3].sstr)
    X#define PREVSP    (fp-3)
    X#define PREVFP    (mstack[fp-2].sfra)
SHAR_EOF
if test 4711 -ne "`wc -c < 'mdef.h'`"
then
    echo shar: error transmitting "'mdef.h'" '(should have been 4711 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'extr.h'" '(1136 characters)'
if test -f 'extr.h'
then
    echo shar: will not over-write existing file "'extr.h'"
else
sed 's/^    X//' << \SHAR_EOF > 'extr.h'
    Xextern ndptr hashtab[];        /* hash table for macros etc.  */
    Xextern char buf[];        /* push-back buffer           */
    Xextern char *bp;        /* first available character   */
    Xextern char *endpbb;        /* end of push-back buffer     */
    Xextern stae mstack[];        /* stack of m4 machine         */
    Xextern char *ep;        /* first free char in strspace */
    Xextern char *endest;        /* end of string space           */
    Xint sp;             /* current m4  stack pointer   */
    Xint fp;             /* m4 call frame pointer       */
    Xextern FILE *infile[];        /* input file stack (0=stdin)  */
    Xextern FILE *outfile[];        /* diversion array(0=bitbucket)*/
    Xextern FILE *active;        /* active output file pointer  */
    Xextern char *m4temp;        /* filename for diversions     */
    Xextern int ilevel;        /* input file stack pointer    */
    Xextern int oindex;        /* diversion index..           */
    Xextern char *null;        /* as it says.. just a null..  */
    Xextern char *m4wraps;        /* m4wrap string default..     */
    Xextern char lquote;        /* left quote character  (`)   */
    Xextern char rquote;        /* right quote character (')   */
    Xextern char scommt;        /* start character for comment */
    Xextern char ecommt;        /* end character for comment   */
SHAR_EOF
if test 1136 -ne "`wc -c < 'extr.h'`"
then
    echo shar: error transmitting "'extr.h'" '(should have been 1136 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'main.c'"
if test -f 'main.c'
then
    echo shar: will not over-write existing file "'main.c'"
else
cat << \SHAR_EOF > 'main.c'
/*
 * main.c
 * Facility: m4 macro processor
 * by: oz
 */

#include "mdef.h"

/*
 * m4 - macro processor
 *
 * PD m4 is based on the macro tool distributed with the software
 * tools (VOS) package, and described in the "SOFTWARE TOOLS" and
 * "SOFTWARE TOOLS IN PASCAL" books. It has been expanded to include
 * most of the command set of SysV m4, the standard UN*X macro processor.
 *
 * Since both PD m4 and UN*X m4 are based on SOFTWARE TOOLS macro,
 * there may be certain implementation similarities between
 * the two. The PD m4 was produced without ANY references to m4
 * sources.
 *
 * References:
 *
 *    Software Tools distribution: macro
 *
 *    Kernighan, Brian W. and P. J. Plauger, SOFTWARE
 *    TOOLS IN PASCAL, Addison-Wesley, Mass. 1981
 *
 *    Kernighan, Brian W. and P. J. Plauger, SOFTWARE
 *    TOOLS, Addison-Wesley, Mass. 1976
 *
 *    Kernighan, Brian W. and Dennis M. Ritchie,
 *    THE M4 MACRO PROCESSOR, Unix Programmer's Manual,
 *    Seventh Edition, Vol. 2, Bell Telephone Labs, 1979
 *
 *    System V man page for M4
 *
 * Modification History:
 *
 * Jan 28 1986 Oz    Break the whole thing into little
 *            pieces, for easier (?) maintenance.
 *
 * Dec 12 1985 Oz    Optimize the code, try to squeeze
 *            few microseconds out..
 *
 * Dec 05 1985 Oz    Add getopt interface, define (-D),
 *            undefine (-U) options.
 *
 * Oct 21 1985 Oz    Clean up various bugs, add comment handling.
 *
 * June 7 1985 Oz    Add some of SysV m4 stuff (m4wrap, pushdef,
 *            popdef, decr, shift etc.).
 *
 * June 5 1985 Oz    Initial cut.
 *
 * Implementation Notes:
 *
 * [1]    PD m4 uses a different (and simpler) stack mechanism than the one
 *    described in Software Tools and Software Tools in Pascal books.
 *    The triple stack nonsense is replaced with a single stack containing
 *    the call frames and the arguments. Each frame is back-linked to a
 *     previous stack frame, which enables us to rewind the stack after
 *     each nested call is completed. Each argument is a character pointer
 *    to the beginning of the argument string within the string space.
 *    The only exceptions to this are (*) arg 0 and arg 1, which are
 *     the macro definition and macro name strings, stored dynamically
 *    for the hash table.
 *
 *        .                       .
 *    |   .    |  <-- sp            |  .  |
 *    +-------+                +-----+
 *    | arg 3 ------------------------------->| str |
 *    +-------+                |  .  |
 *    | arg 2 --------------+            .
 *    +-------+          |
 *        *              |            |     |
 *    +-------+          |         +-----+
 *    | plev    |  <-- fp     +---------------->| str |
 *    +-------+                |  .  |
 *    | type    |                   .
 *    +-------+
 *    | prcf    -----------+        plev: paren level
 *    +-------+         |        type: call type
 *    |   .    |        |        prcf: prev. call frame
 *        .              |
 *    +-------+       |
 *    |    <----------+
 *    +-------+
 *
 * [2]    We have three types of null values:
 *
 *        nil  - nodeblock pointer type 0
 *        null - null string ("")
 *        NULL - Stdio-defined NULL
 *
 */

ndptr hashtab[HASHSIZE];    /* hash table for macros etc.  */
char buf[BUFSIZE];        /* push-back buffer           */
char *bp = buf;         /* first available character   */
char *endpbb = buf+BUFSIZE;    /* end of push-back buffer     */
stae mstack[STACKMAX+1];     /* stack of m4 machine         */
char strspace[STRSPMAX+1];    /* string space for evaluation */
char *ep = strspace;        /* first free char in strspace */
char *endest= strspace+STRSPMAX;/* end of string space           */
int sp;             /* current m4  stack pointer   */
int fp;             /* m4 call frame pointer       */
FILE *infile[MAXINP];        /* input file stack (0=stdin)  */
FILE *outfile[MAXOUT];        /* diversion array(0=bitbucket)*/
FILE *active;            /* active output file pointer  */
char *m4temp;            /* filename for diversions     */
int ilevel = 0;         /* input file stack pointer    */
int oindex = 0;         /* diversion index..           */
char *null = "";                /* as it says.. just a null..  */
char *m4wraps = "";             /* m4wrap string default..     */
char lquote = LQUOTE;        /* left quote character  (`)   */
char rquote = RQUOTE;        /* right quote character (')   */
char scommt = SCOMMT;        /* start character for comment */
char ecommt = ECOMMT;        /* end character for comment   */
struct keyblk keywrds[] = {    /* m4 keywords to be installed */
    "include",      INCLTYPE,
    "sinclude",     SINCTYPE,
    "define",       DEFITYPE,
    "defn",         DEFNTYPE,
    "divert",       DIVRTYPE,
    "expr",         EXPRTYPE,
    "eval",         EXPRTYPE,
    "substr",       SUBSTYPE,
    "ifelse",       IFELTYPE,
    "ifdef",        IFDFTYPE,
    "len",          LENGTYPE,
    "incr",         INCRTYPE,
    "decr",         DECRTYPE,
    "dnl",          DNLNTYPE,
    "changequote",  CHNQTYPE,
    "changecom",    CHNCTYPE,
    "index",        INDXTYPE,
#ifdef EXTENDED
    "paste",        PASTTYPE,
    "spaste",       SPASTYPE,
#endif
    "popdef",       POPDTYPE,
    "pushdef",      PUSDTYPE,
    "dumpdef",      DUMPTYPE,
    "shift",        SHIFTYPE,
    "translit",     TRNLTYPE,
    "undefine",     UNDFTYPE,
    "undivert",     UNDVTYPE,
    "divnum",       DIVNTYPE,
    "maketemp",     MKTMTYPE,
    "errprint",     ERRPTYPE,
    "m4wrap",       M4WRTYPE,
    "m4exit",       EXITTYPE,
#if unix || vms
    "syscmd",       SYSCTYPE,
    "sysval",       SYSVTYPE,
#endif
#if unix
    "unix",         MACRTYPE,
#else
#if vms
    "vms",          MACRTYPE,
#endif
#endif
};

#define MAXKEYS    (sizeof(keywrds)/sizeof(struct keyblk))

extern ndptr lookup();
extern ndptr addent();
extern int onintr();

extern char *malloc();
extern char *mktemp();

extern int optind;
extern char *optarg;

main(argc,argv)
char *argv[];
{
    register int c;
    register int n;
    char *p;

    if (signal(SIGINT, SIG_IGN) != SIG_IGN)
        signal(SIGINT, onintr);
#ifdef NONZEROPAGES
    initm4();
#endif
    initkwds();

    while ((c = getopt(argc, argv, "tD:U:o:")) != EOF)
        switch(c) {

        case 'D':               /* define something..*/
            for (p = optarg; *p; p++)
                if (*p == '=')
                    break;
            if (*p)
                *p++ = EOS;
            dodefine(optarg, p);
            break;
        case 'U':               /* undefine...       */
            remhash(optarg, TOP);
            break;
        case 'o':        /* specific output   */
        case '?':
        default:
            usage();
        }

    infile[0] = stdin;        /* default input (naturally) */
    active = stdout;        /* default active output     */
    m4temp = mktemp(DIVNAM);    /* filename for diversions   */

    sp = -1;            /* stack pointer initialized */
    fp = 0;             /* frame pointer initialized */

    macro();            /* get some work done here   */

    if (*m4wraps) {         /* anything for rundown ??   */
        ilevel = 0;        /* in case m4wrap includes.. */
        putback(EOF);        /* eof is a must !!         */
        pbstr(m4wraps);     /* user-defined wrapup act   */
        macro();        /* last will and testament   */
    }
    else                /* default wrap-up: undivert */
        for (n = 1; n < MAXOUT; n++)
            if (outfile[n] != NULL)
                getdiv(n);

                    /* remove bitbucket if used  */
    if (outfile[0] != NULL) {
        (void) fclose(outfile[0]);
        m4temp[UNIQUE] = '0';
#if vms
        (void) remove(m4temp);
#else
        (void) unlink(m4temp);
#endif
    }

    exit(0);
}

ndptr inspect();    /* forward ... */

/*
 * macro - the work horse..
 *
 */
macro() {
    char token[MAXTOK];
    register char *s;
    register int t, l;
    register ndptr p;
    register int  nlpar;

    cycle {
        if ((t = gpbc()) == '_' || isalpha(t)) {
            putback(t);
            if ((p = inspect(s = token)) == nil) {
                if (sp < 0)
                    while (*s)
                        putc(*s++, active);
                else
                    while (*s)
                        chrsave(*s++);
            }
            else {
        /*
         * real thing.. First build a call frame:
         *
         */
                pushf(fp);    /* previous call frm */
                pushf(p->type); /* type of the call  */
                pushf(0);    /* parenthesis level */
                fp = sp;    /* new frame pointer */
        /*
         * now push the string arguments:
         *
         */
                pushs(p->defn);          /* defn string */
                pushs(p->name);          /* macro name  */
                pushs(ep);          /* start next..*/

                putback(l = gpbc());
                if (l != LPAREN)  {   /* add bracks  */
                    putback(RPAREN);
                    putback(LPAREN);
                }
            }
        }
        else if (t == EOF) {
            if (sp > -1)
                error("m4: unexpected end of input");
            if (--ilevel < 0)
                break;            /* all done thanks.. */
            (void) fclose(infile[ilevel+1]);
            continue;
        }
    /*
     * non-alpha single-char token seen..
     * [the order of else if .. stmts is
     * important.]
     *
     */
        else if (t == lquote) {         /* strip quotes */
            nlpar = 1;
            do {
                if ((l = gpbc()) == rquote)
                    nlpar--;
                else if (l == lquote)
                    nlpar++;
                else if (l == EOF)
                    error("m4: missing right quote");
                if (nlpar > 0)
                    chrsave(l);
            }
            while (nlpar != 0);
        }

        else if (sp < 0) {        /* not in a macro at all */
            if (t == scommt) {    /* comment handling here */
                putc(t, active);
                while ((t = gpbc()) != ecommt)
                    putc(t, active);
            }
            putc(t, active);    /* output directly..     */
        }

        else switch(t) {

        case LPAREN:
            if (PARLEV > 0)
                chrsave(t);
            while (isspace(l = gpbc()))
                ;        /* skip blank, tab, nl.. */
            putback(l);
            PARLEV++;
            break;

        case RPAREN:
            if (--PARLEV > 0)
                chrsave(t);
            else {            /* end of argument list */
                chrsave(EOS);

                if (sp == STACKMAX)
                    error("m4: internal stack overflow");

                if (CALTYP == MACRTYPE)
                    expand(mstack+fp+1, sp-fp);
                else
                    eval(mstack+fp+1, sp-fp, CALTYP);

                ep = PREVEP;    /* flush strspace */
                sp = PREVSP;    /* previous sp..  */
                fp = PREVFP;    /* rewind stack...*/
            }
            break;

        case COMMA:
            if (PARLEV == 1)    {
                chrsave(EOS);        /* new argument   */
                while (isspace(l = gpbc()))
                    ;
                putback(l);
                pushs(ep);
            }
            break;
        default:
            chrsave(t);            /* stack the char */
            break;
        }
    }
}


/*
 * build an input token..
 * consider only those starting with _ or A-Za-z. This is a
 * combo with lookup to speed things up.
 */
ndptr
inspect(tp)
register char *tp;
{
    register int h = 0;
    register char c;
    register char *name = tp;
    register char *etp = tp+MAXTOK;
    register ndptr p;

    while (tp < etp && (isalnum(c = gpbc()) || c == '_'))
        h += (*tp++ = c);
    putback(c);
    if (tp == etp)
        error("m4: token too long");
    *tp = EOS;
    for (p = hashtab[h%HASHSIZE]; p != nil; p = p->nxtptr)
        if (strcmp(name, p->name) == 0)
            break;
    return(p);
}

#ifdef NONZEROPAGES
/*
 * initm4 - initialize various tables. Useful only if your system
 * does not know anything about demand-zero pages.
 *
 */
initm4()
{
    register int i;

    for (i = 0; i < HASHSIZE; i++)
        hashtab[i] = nil;
    for (i = 0; i < MAXOUT; i++)
        outfile[i] = NULL;
}
#endif

/*
 * initkwds - initialise m4 keywords as fast as possible.
 * This very similar to install, but without certain overheads,
 * such as calling lookup. Malloc is not used for storing the
 * keyword strings, since we simply use the static  pointers
 * within keywrds block. We also assume that there is enough memory
 * to at least install the keywords (i.e. malloc won't fail).
 *
 */
initkwds() {
    register int i;
    register int h;
    register ndptr p;

    for (i = 0; i < MAXKEYS; i++) {
        h = hash(keywrds[i].knam);
        p = (ndptr) malloc(sizeof(struct ndblock));
        p->nxtptr = hashtab[h];
        hashtab[h] = p;
        p->name = keywrds[i].knam;
        p->defn = null;
        p->type = keywrds[i].ktyp | STATIC;
    }
}
SHAR_EOF
fi # end of overwriting check
echo shar: extracting "'eval.c'" '(5707 characters)'
if test -f 'eval.c'
then
    echo shar: will not over-write existing file "'eval.c'"
else
sed 's/^    X//' << \SHAR_EOF > 'eval.c'
    X/*
    X * eval.c
    X * Facility: m4 macro processor
    X * by: oz
    X */
    X
    X#include "mdef.h"
    X#include "extr.h"
    X
    Xextern ndptr lookup();
    Xextern char *strsave();
    Xextern char *mktemp();
    X
    X/*
    X * eval - evaluate built-in macros.
    X *      argc - number of elements in argv.
    X *      argv - element vector :
    X *            argv[0] = definition of a user
    X *                  macro or nil if built-in.
    X *            argv[1] = name of the macro or
    X *                  built-in.
    X *            argv[2] = parameters to user-defined
    X *               .      macro or built-in.
    X *               .
    X *
    X * Note that the minimum value for argc is 3. A call in the form
    X * of macro-or-builtin() will result in:
    X *            argv[0] = nullstr
    X *            argv[1] = macro-or-builtin
    X *            argv[2] = nullstr
    X *
    X */
    X
    Xeval (argv, argc, td)
    Xregister char *argv[];
    Xregister int argc;
    Xregister int  td;
    X{
    X    register int c, n;
    X    static int sysval;
    X
    X#ifdef DEBUG
    X    printf("argc = %d\n", argc);
    X    for (n = 0; n < argc; n++)
    X        printf("argv[%d] = %s\n", n, argv[n]);
    X#endif
    X    /*
    X     * if argc == 3 and argv[2] is null,
    X     * then we have macro-or-builtin() type call.
    X     * We adjust argc to avoid further checking..
    X     *
    X     */
    X    if (argc == 3 && !*(argv[2]))
    X        argc--;
    X
    X    switch (td & ~STATIC) {
    X
    X    case DEFITYPE:
    X        if (argc > 2)
    X            dodefine(argv[2], (argc > 3) ? argv[3] : null);
    X        break;
    X
    X    case PUSDTYPE:
    X        if (argc > 2)
    X            dopushdef(argv[2], (argc > 3) ? argv[3] : null);
    X        break;
    X
    X    case DUMPTYPE:
    X        dodump(argv, argc);
    X        break;
    X
    X    case EXPRTYPE:
    X        /*
    X         * doexpr - evaluate arithmetic expression
    X         *
    X         */
    X        if (argc > 2)
    X            pbnum(expr(argv[2]));
    X        break;
    X
    X    case IFELTYPE:
    X        if (argc > 4)
    X            doifelse(argv, argc);
    X        break;
    X
    X    case IFDFTYPE:
    X        /*
    X         * doifdef - select one of two alternatives based
    X         *         on the existence of another definition
    X         */
    X        if (argc > 3) {
    X            if (lookup(argv[2]) != nil)
    X                pbstr(argv[3]);
    X            else if (argc > 4)
    X                pbstr(argv[4]);
    X        }
    X        break;
    X
    X    case LENGTYPE:
    X        /*
    X         * dolen - find the length of the argument
    X         *
    X         */
    X        if (argc > 2)
    X            pbnum((argc > 2) ? strlen(argv[2]) : 0);
    X        break;
    X
    X    case INCRTYPE:
    X        /*
    X         * doincr - increment the value of the argument
    X         *
    X         */
    X        if (argc > 2)
    X            pbnum(atoi(argv[2]) + 1);
    X        break;
    X
    X    case DECRTYPE:
    X        /*
    X         * dodecr - decrement the value of the argument
    X         *
    X         */
    X        if (argc > 2)
    X            pbnum(atoi(argv[2]) - 1);
    X        break;
    X
    X#if unix || vms
    X
    X    case SYSCTYPE:
    X        /*
    X         * dosys - execute system command
    X         *
    X         */
    X        if (argc > 2)
    X            sysval = system(argv[2]);
    X        break;
    X
    X    case SYSVTYPE:
    X        /*
    X         * dosysval - return value of the last system call.
    X         *
    X         */
    X        pbnum(sysval);
    X        break;
    X#endif
    X
    X    case INCLTYPE:
    X        if (argc > 2)
    X            if (!doincl(argv[2])) {
    X                fprintf(stderr,"m4: %s: ",argv[2]);
    X                error("cannot open for read.");
    X            }
    X        break;
    X
    X    case SINCTYPE:
    X        if (argc > 2)
    X            (void) doincl(argv[2]);
    X        break;
    X#ifdef EXTENDED
    X    case PASTTYPE:
    X        if (argc > 2)
    X            if (!dopaste(argv[2])) {
    X                fprintf(stderr,"m4: %s: ",argv[2]);
    X                error("cannot open for read.");
    X            }
    X        break;
    X
    X    case SPASTYPE:
    X        if (argc > 2)
    X            (void) dopaste(argv[2]);
    X        break;
    X#endif
    X    case CHNQTYPE:
    X        dochq(argv, argc);
    X        break;
    X
    X    case CHNCTYPE:
    X        dochc(argv, argc);
    X        break;
    X
    X    case SUBSTYPE:
    X        /*
    X         * dosub - select substring
    X         *
    X         */
    X        if (argc > 3)
    X            dosub(argv,argc);
    X        break;
    X
    X    case SHIFTYPE:
    X        /*
    X         * doshift - push back all arguments except the
    X         *         first one (i.e. skip argv[2])
    X         */
    X        if (argc > 3) {
    X            for (n = argc-1; n > 3; n--) {
    X                putback(rquote);
    X                pbstr(argv[n]);
    X                putback(lquote);
    X                putback(',');
    X            }
    X            putback(rquote);
    X            pbstr(argv[3]);
    X            putback(lquote);
    X        }
    X        break;
    X
    X    case DIVRTYPE:
    X        if (argc > 2 && (n = atoi(argv[2])) != 0)
    X            dodiv(n);
    X        else {
    X            active = stdout;
    X            oindex = 0;
    X        }
    X        break;
    X
    X    case UNDVTYPE:
    X        doundiv(argv, argc);
    X        break;
    X
    X    case DIVNTYPE:
    X        /*
    X         * dodivnum - return the number of current
    X         * output diversion
    X         *
    X         */
    X        pbnum(oindex);
    X        break;
    X
    X    case UNDFTYPE:
    X        /*
    X         * doundefine - undefine a previously defined
    X         *        macro(s) or m4 keyword(s).
    X         */
    X        if (argc > 2)
    X            for (n = 2; n < argc; n++)
    X                remhash(argv[n], ALL);
    X        break;
    X
    X    case POPDTYPE:
    X        /*
    X         * dopopdef - remove the topmost definitions of
    X         *          macro(s) or m4 keyword(s).
    X         */
    X        if (argc > 2)
    X            for (n = 2; n < argc; n++)
    X                remhash(argv[n], TOP);
    X        break;
    X
    X    case MKTMTYPE:
    X        /*
    X         * dotemp - create a temporary file
    X         *
    X         */
    X        if (argc > 2)
    X            pbstr(mktemp(argv[2]));
    X        break;
    X
    X    case TRNLTYPE:
    X        /*
    X         * dotranslit - replace all characters in the
    X         *        source string that appears in
    X         *        the "from" string with the corresponding
    X         *        characters in the "to" string.
    X         *
    X         */
    X        if (argc > 3) {
    X            char temp[MAXTOK];
    X            if (argc > 4)
    X                map(temp, argv[2], argv[3], argv[4]);
    X            else
    X                map(temp, argv[2], argv[3], null);
    X            pbstr(temp);
    X        }
    X        else
    X            if (argc > 2)
    X            pbstr(argv[2]);
    X        break;
    X
    X    case INDXTYPE:
    X        /*
    X         * doindex - find the index of the second argument
    X         *         string in the first argument string.
    X         *         -1 if not present.
    X         */
    X        pbnum((argc > 3) ? indx(argv[2], argv[3]) : -1);
    X        break;
    X
    X    case ERRPTYPE:
    X        /*
    X         * doerrp - print the arguments to stderr file
    X         *
    X         */
    X        if (argc > 2) {
    X            for (n = 2; n < argc; n++)
    X                fprintf(stderr,"%s ", argv[n]);
    X            fprintf(stderr, "\n");
    X        }
    X        break;
    X
    X    case DNLNTYPE:
    X        /*
    X         * dodnl - eat-up-to and including newline
    X         *
    X         */
    X        while ((c = gpbc()) != '\n' && c != EOF)
    X            ;
    X        break;
    X
    X    case M4WRTYPE:
    X        /*
    X         * dom4wrap - set up for wrap-up/wind-down activity
    X         *
    X         */
    X        m4wraps = (argc > 2) ? strsave(argv[2]) : null;
    X        break;
    X
    X    case EXITTYPE:
    X        /*
    X         * doexit - immediate exit from m4.
    X         *
    X         */
    X        exit((argc > 2) ? atoi(argv[2]) : 0);
    X        break;
    X
    X    case DEFNTYPE:
    X        if (argc > 2)
    X            for (n = 2; n < argc; n++)
    X                dodefn(argv[n]);
    X        break;
    X
    X    default:
    X        error("m4: major botch in eval.");
    X        break;
    X    }
    X}
SHAR_EOF
if test 5707 -ne "`wc -c < 'eval.c'`"
then
    echo shar: error transmitting "'eval.c'" '(should have been 5707 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'serv.c'" '(11554 characters)'
if test -f 'serv.c'
then
    echo shar: will not over-write existing file "'serv.c'"
else
sed 's/^    X//' << \SHAR_EOF > 'serv.c'
    X/*
    X * serv.c
    X * Facility: m4 macro processor
    X * by: oz
    X */
    X
    X#include "mdef.h"
    X#include "extr.h"
    X
    Xextern ndptr lookup();
    Xextern ndptr addent();
    Xextern char  *strsave();
    X
    Xchar *dumpfmt = "`%s'\t`%s'\n"; /* format string for dumpdef   */
    X
    X/*
    X * expand - user-defined macro expansion
    X *
    X */
    Xexpand(argv, argc)
    Xregister char *argv[];
    Xregister int argc;
    X{
    X        register char *t;
    X        register char *p;
    X        register int  n;
    X        register int  argno;
    X
    X        t = argv[0];    /* defn string as a whole */
    X        p = t;
    X        while (*p)
    X                p++;
    X        p--;            /* last character of defn */
    X        while (p > t) {
    X                if (*(p-1) != ARGFLAG)
    X                        putback(*p);
    X                else {
    X                        switch (*p) {
    X
    X                        case '#':
    X                                pbnum(argc-2);
    X                                break;
    X                        case '0':
    X                        case '1':
    X                        case '2':
    X                        case '3':
    X                        case '4':
    X                        case '5':
    X                        case '6':
    X                        case '7':
    X                        case '8':
    X                        case '9':
    X                                if ((argno = *p - '0') < argc-1)
    X                                        pbstr(argv[argno+1]);
    X                                break;
    X                        case '*':
    X                                for (n = argc - 1; n > 2; n--) {
    X                                        pbstr(argv[n]);
    X                                        putback(',');
    X                                }
    X                                pbstr(argv[2]);
    X                                break;
    X                        default :
    X                                putback(*p);
    X                                break;
    X                        }
    X                        p--;
    X                }
    X                p--;
    X        }
    X        if (p == t)         /* do last character */
    X                putback(*p);
    X}
    X
    X/*
    X * dodefine - install definition in the table
    X *
    X */
    Xdodefine(name, defn)
    Xregister char *name;
    Xregister char *defn;
    X{
    X        register ndptr p;
    X
    X        if (!*name)
    X                error("m4: null definition.");
    X        if (strcmp(name, defn) == 0)
    X                error("m4: recursive definition.");
    X        if ((p = lookup(name)) == nil)
    X                p = addent(name);
    X        else if (p->defn != null)
    X                free(p->defn);
    X        if (!*defn)
    X                p->defn = null;
    X        else
    X                p->defn = strsave(defn);
    X        p->type = MACRTYPE;
    X}
    X
    X/*
    X * dodefn - push back a quoted definition of
    X *      the given name.
    X */
    X
    Xdodefn(name)
    Xchar *name;
    X{
    X        register ndptr p;
    X
    X        if ((p = lookup(name)) != nil && p->defn != null) {
    X                putback(rquote);
    X                pbstr(p->defn);
    X                putback(lquote);
    X        }
    X}
    X
    X/*
    X * dopushdef - install a definition in the hash table
    X *      without removing a previous definition. Since
    X *      each new entry is entered in *front* of the
    X *      hash bucket, it hides a previous definition from
    X *      lookup.
    X */
    Xdopushdef(name, defn)
    Xregister char *name;
    Xregister char *defn;
    X{
    X        register ndptr p;
    X
    X        if (!*name)
    X                error("m4: null definition");
    X        if (strcmp(name, defn) == 0)
    X                error("m4: recursive definition.");
    X        p = addent(name);
    X        if (!*defn)
    X                p->defn = null;
    X        else
    X                p->defn = strsave(defn);
    X        p->type = MACRTYPE;
    X}
    X
    X/*
    X * dodumpdef - dump the specified definitions in the hash
    X *      table to stderr. If nothing is specified, the entire
    X *      hash table is dumped.
    X *
    X */
    Xdodump(argv, argc)
    Xregister char *argv[];
    Xregister int argc;
    X{
    X        register int n;
    X        ndptr p;
    X
    X        if (argc > 2) {
    X                for (n = 2; n < argc; n++)
    X                        if ((p = lookup(argv[n])) != nil)
    X                                fprintf(stderr, dumpfmt, p->name,
    X                                p->defn);
    X        }
    X        else {
    X                for (n = 0; n < HASHSIZE; n++)
    X                        for (p = hashtab[n]; p != nil; p = p->nxtptr)
    X                                fprintf(stderr, dumpfmt, p->name,
    X                                p->defn);
    X        }
    X}
    X
    X/*
    X * doifelse - select one of two alternatives - loop.
    X *
    X */
    Xdoifelse(argv,argc)
    Xregister char *argv[];
    Xregister int argc;
    X{
    X        cycle {
    X                if (strcmp(argv[2], argv[3]) == 0)
    X                        pbstr(argv[4]);
    X                else if (argc == 6)
    X                        pbstr(argv[5]);
    X                else if (argc > 6) {
    X                        argv += 3;
    X                        argc -= 3;
    X                        continue;
    X                }
    X                break;
    X        }
    X}
    X
    X/*
    X * doinclude - include a given file.
    X *
    X */
    Xdoincl(ifile)
    Xchar *ifile;
    X{
    X        if (ilevel+1 == MAXINP)
    X                error("m4: too many include files.");
    X        if ((infile[ilevel+1] = fopen(ifile, "r")) != NULL) {
    X                ilevel++;
    X                return (1);
    X        }
    X        else
    X                return (0);
    X}
    X
    X#ifdef EXTENDED
    X/*
    X * dopaste - include a given file without any
    X *           macro processing.
    X */
    Xdopaste(pfile)
    Xchar *pfile;
    X{
    X        FILE *pf;
    X        register int c;
    X
    X        if ((pf = fopen(pfile, "r")) != NULL) {
    X                while((c = getc(pf)) != EOF)
    X                        putc(c, active);
    X                (void) fclose(pf);
    X                return(1);
    X        }
    X        else
    X                return(0);
    X}
    X#endif
    X
    X/*
    X * dochq - change quote characters
    X *
    X */
    Xdochq(argv, argc)
    Xregister char *argv[];
    Xregister int argc;
    X{
    X        if (argc > 2) {
    X                if (*argv[2])
    X                        lquote = *argv[2];
    X                if (argc > 3) {
    X                        if (*argv[3])
    X                                rquote = *argv[3];
    X                }
    X                else
    X                        rquote = lquote;
    X        }
    X        else {
    X                lquote = LQUOTE;
    X                rquote = RQUOTE;
    X        }
    X}
    X
    X/*
    X * dochc - change comment characters
    X *
    X */
    Xdochc(argv, argc)
    Xregister char *argv[];
    Xregister int argc;
    X{
    X        if (argc > 2) {
    X                if (*argv[2])
    X                        scommt = *argv[2];
    X                if (argc > 3) {
    X                        if (*argv[3])
    X                                ecommt = *argv[3];
    X                }
    X                else
    X                        ecommt = ECOMMT;
    X        }
    X        else {
    X                scommt = SCOMMT;
    X                ecommt = ECOMMT;
    X        }
    X}
    X
    X/*
    X * dodivert - divert the output to a temporary file
    X *
    X */
    Xdodiv(n)
    Xregister int n;
    X{
    X        if (n < 0 || n >= MAXOUT)
    X                n = 0;                  /* bitbucket */
    X        if (outfile[n] == NULL) {
    X                m4temp[UNIQUE] = n + '0';
    X                if ((outfile[n] = fopen(m4temp, "w")) == NULL)
    X                        error("m4: cannot divert.");
    X        }
    X        oindex = n;
    X        active = outfile[n];
    X}
    X
    X/*
    X * doundivert - undivert a specified output, or all
    X *              other outputs, in numerical order.
    X */
    Xdoundiv(argv, argc)
    Xregister char *argv[];
    Xregister int argc;
    X{
    X        register int ind;
    X        register int n;
    X
    X        if (argc > 2) {
    X                for (ind = 2; ind < argc; ind++) {
    X                        n = atoi(argv[ind]);
    X                        if (n > 0 && n < MAXOUT && outfile[n] != NULL)
    X                                getdiv(n);
    X
    X                }
    X        }
    X        else
    X                for (n = 1; n < MAXOUT; n++)
    X                        if (outfile[n] != NULL)
    X                                getdiv(n);
    X}
    X
    X/*
    X * dosub - select substring
    X *
    X */
    Xdosub (argv, argc)
    Xregister char *argv[];
    Xregister int  argc;
    X{
    X        register char *ap, *fc, *k;
    X        register int nc;
    X
    X        if (argc < 5)
    X                nc = MAXTOK;
    X        else
    X#ifdef EXPR
    X                nc = expr(argv[4]);
    X#else
    X        nc = atoi(argv[4]);
    X#endif
    X        ap = argv[2];                   /* target string */
    X#ifdef EXPR
    X        fc = ap + expr(argv[3]);        /* first char */
    X#else
    X        fc = ap + atoi(argv[3]);        /* first char */
    X#endif
    X        if (fc >= ap && fc < ap+strlen(ap))
    X                for (k = fc+min(nc,strlen(fc))-1; k >= fc; k--)
    X                        putback(*k);
    X}
    X
    X/*
    X * map:
    X * map every character of s1 that is specified in from
    X * into s3 and replace in s. (source s1 remains untouched)
    X *
    X * This is a standard implementation of map(s,from,to) function of ICON
    X * language. Within mapvec, we replace every character of "from" with
    X * the corresponding character in "to". If "to" is shorter than "from",
    X * than the corresponding entries are null, which means that those
    X * characters dissapear altogether. Furthermore, imagine
    X * map(dest, "sourcestring", "srtin", "rn..*") type call. In this case,
    X * `s' maps to `r', `r' maps to `n' and `n' maps to `*'. Thus, `s'
    X * ultimately maps to `*'. In order to achieve this effect in an efficient
    X * manner (i.e. without multiple passes over the destination string), we
    X * loop over mapvec, starting with the initial source character. if the
    X * character value (dch) in this location is different than the source
    X * character (sch), sch becomes dch, once again to index into mapvec, until
    X * the character value stabilizes (i.e. sch = dch, in other words
    X * mapvec[n] == n). Even if the entry in the mapvec is null for an ordinary
    X * character, it will stabilize, since mapvec[0] == 0 at all times. At the
    X * end, we restore mapvec* back to normal where mapvec[n] == n for
    X * 0 <= n <= 127. This strategy, along with the restoration of mapvec, is
    X * about 5 times faster than any algorithm that makes multiple passes over
    X * destination string.
    X *
    X */
    X
    Xmap(dest,src,from,to)
    Xregister char *dest;
    Xregister char *src;
    Xregister char *from;
    Xregister char *to;
    X{
    X        register char *tmp;
    X        register char sch, dch;
    X        static char mapvec[128] = {
    X                0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11,
    X                12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23,
    X                24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35,
    X                36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47,
    X                48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59,
    X                60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71,
    X                72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83,
    X                84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95,
    X                96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107,
    X                108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119,
    X                120, 121, 122, 123, 124, 125, 126, 127
    X        };
    X
    X        if (*src) {
    X                tmp = from;
    X    /*
    X     * create a mapping between "from" and "to"
    X     */
    X                while (*from)
    X                        mapvec[*from++] = (*to) ? *to++ : (char) 0;
    X
    X                while (*src) {
    X                        sch = *src++;
    X                        dch = mapvec[sch];
    X                        while (dch != sch) {
    X                                sch = dch;
    X                                dch = mapvec[sch];
    X                        }
    X                        if (*dest = dch)
    X                                dest++;
    X                }
    X    /*
    X     * restore all the changed characters
    X     */
    X                while (*tmp) {
    X                        mapvec[*tmp] = *tmp;
    X                        tmp++;
    X                }
    X        }
    X        *dest = (char) 0;
    X}
SHAR_EOF
if test 11554 -ne "`wc -c < 'serv.c'`"
then
    echo shar: error transmitting "'serv.c'" '(should have been 11554 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'look.c'" '(1617 characters)'
if test -f 'look.c'
then
    echo shar: will not over-write existing file "'look.c'"
else
sed 's/^    X//' << \SHAR_EOF > 'look.c'
    X/*
    X * look.c
    X * Facility: m4 macro processor
    X * by: oz
    X */
    X
    X#include "mdef.h"
    X#include "extr.h"
    X
    Xextern char *strsave();
    X
    X/*
    X *  hash - compute hash value using the proverbial
    X *       hashing function. Taken from K&R.
    X */
    Xhash (name)
    Xregister char *name;
    X{
    X    register int h = 0;
    X    while (*name)
    X        h += *name++;
    X    return (h % HASHSIZE);
    X}
    X
    X/*
    X * lookup - find name in the hash table
    X *
    X */
    Xndptr lookup(name)
    Xchar *name;
    X{
    X    register ndptr p;
    X
    X    for (p = hashtab[hash(name)]; p != nil; p = p->nxtptr)
    X        if (strcmp(name, p->name) == 0)
    X            break;
    X    return (p);
    X}
    X
    X/*
    X * addent - hash and create an entry in the hash
    X *        table. The new entry is added in front
    X *        of a hash bucket.
    X */
    Xndptr addent(name)
    Xchar *name;
    X{
    X    register int h;
    X    ndptr p;
    X
    X    h = hash(name);
    X    if ((p = (ndptr) malloc(sizeof(struct ndblock))) != NULL) {
    X        p->nxtptr = hashtab[h];
    X        hashtab[h] = p;
    X        p->name = strsave(name);
    X    }
    X    else
    X        error("m4: no more memory.");
    X    return p;
    X}
    X
    X/*
    X * remhash - remove an entry from the hashtable
    X *
    X */
    Xremhash(name, all)
    Xchar *name;
    Xint all;
    X{
    X    register int h;
    X    register ndptr xp, tp, mp;
    X
    X    h = hash(name);
    X    mp = hashtab[h];
    X    tp = nil;
    X    while (mp != nil) {
    X        if (strcmp(mp->name, name) == 0) {
    X            mp = mp->nxtptr;
    X            if (tp == nil) {
    X                freent(hashtab[h]);
    X                hashtab[h] = mp;
    X            }
    X            else {
    X                xp = tp->nxtptr;
    X                tp->nxtptr = mp;
    X                freent(xp);
    X            }
    X            if (!all)
    X                break;
    X        }
    X        else {
    X            tp = mp;
    X            mp = mp->nxtptr;
    X        }
    X    }
    X}
    X
    X/*
    X * freent - free a hashtable information block
    X *
    X */
    Xfreent(p)
    Xndptr p;
    X{
    X    if (!(p->type & STATIC)) {
    X        free(p->name);
    X        if (p->defn != null)
    X            free(p->defn);
    X    }
    X    free(p);
    X}
    X
SHAR_EOF
if test 1617 -ne "`wc -c < 'look.c'`"
then
    echo shar: error transmitting "'look.c'" '(should have been 1617 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'misc.c'" '(5005 characters)'
if test -f 'misc.c'
then
    echo shar: will not over-write existing file "'misc.c'"
else
sed 's/^    X//' << \SHAR_EOF > 'misc.c'
    X/*
    X * misc.c
    X * Facility: m4 macro processor
    X * by: oz
    X */
    X
    X#include "mdef.h"
    X#include "extr.h"
    X
    Xextern char *malloc();
    X
    X/*
    X * indx - find the index of second str in the
    X *        first str.
    X */
    Xindx(s1, s2)
    Xchar *s1;
    Xchar *s2;
    X{
    X        register char *t;
    X        register char *p;
    X        register char *m;
    X
    X        for (p = s1; *p; p++) {
    X                for (t = p, m = s2; *m && *m == *t; m++, t++)
    X                        ;
    X                if (!*m)
    X                        return(p - s1);
    X        }
    X        return (-1);
    X}
    X
    X/*
    X *  putback - push character back onto input
    X *
    X */
    Xputback (c)
    Xchar c;
    X{
    X        if (bp < endpbb)
    X                *bp++ = c;
    X        else
    X                error("m4: too many characters pushed back");
    X}
    X
    X/*
    X *  pbstr - push string back onto input
    X *          putback is replicated to improve
    X *          performance.
    X *
    X */
    Xpbstr(s)
    Xregister char *s;
    X{
    X        register char *es;
    X    register char *zp;
    X
    X    es = s;
    X    zp = bp;
    X
    X        while (*es)
    X                es++;
    X        es--;
    X        while (es >= s)
    X                if (zp < endpbb)
    X                        *zp++ = *es--;
    X        if ((bp = zp) == endpbb)
    X                error("m4: too many characters pushed back");
    X}
    X
    X/*
    X *  pbnum - convert number to string, push back on input.
    X *
    X */
    Xpbnum (n)
    Xint n;
    X{
    X        register int num;
    X
    X        num = (n < 0) ? -n : n;
    X        do {
    X                putback(num % 10 + '0');
    X        }
    X        while ((num /= 10) > 0);
    X
    X        if (n < 0) putback('-');
    X}
    X
    X/*
    X *  chrsave - put single char on string space
    X *
    X */
    Xchrsave (c)
    Xchar c;
    X{
    X/***        if (sp < 0)
    X                putc(c, active);
    X        else ***/ if (ep < endest)
    X                *ep++ = c;
    X        else
    X                error("m4: string space overflow");
    X}
    X
    X/*
    X * getdiv - read in a diversion file, and
    X *          trash it.
    X */
    Xgetdiv(ind) {
    X        register int c;
    X        register FILE *dfil;
    X
    X        if (active == outfile[ind])
    X                error("m4: undivert: diversion still active.");
    X        (void) fclose(outfile[ind]);
    X        outfile[ind] = NULL;
    X        m4temp[UNIQUE] = ind + '0';
    X        if ((dfil = fopen(m4temp, "r")) == NULL)
    X                error("m4: cannot undivert.");
    X        else
    X                while((c = getc(dfil)) != EOF)
    X                        putc(c, active);
    X        (void) fclose(dfil);
    X
    X#if vms
    X        if (remove(m4temp))
    X#else
    X    if (unlink(m4temp) == -1)
    X#endif
    X                error("m4: cannot unlink.");
    X}
    X
    X/*
    X * Very fatal error. Close all files
    X * and die hard.
    X */
    Xerror(s)
    Xchar *s;
    X{
    X        killdiv();
    X        fprintf(stderr,"%s\n",s);
    X        exit(1);
    X}
    X
    X/*
    X * Interrupt handling
    X */
    Xstatic char *msg = "\ninterrupted.";
    X
    Xonintr() {
    X        error(msg);
    X}
    X
    X/*
    X * killdiv - get rid of the diversion files
    X *
    X */
    Xkilldiv() {
    X        register int n;
    X
    X        for (n = 0; n < MAXOUT; n++)
    X                if (outfile[n] != NULL) {
    X                        (void) fclose (outfile[n]);
    X                        m4temp[UNIQUE] = n + '0';
    X#if vms
    X            (void) remove (m4temp);
    X#else
    X                        (void) unlink (m4temp);
    X#endif
    X                }
    X}
    X
    X/*
    X * save a string somewhere..
    X *
    X */
    Xchar *strsave(s)
    Xchar *s;
    X{
    X    register int n;
    X        char *p;
    X
    X        if ((p = malloc (n = strlen(s)+1)) != NULL)
    X                (void) memcpy(p, s, n);
    X        return (p);
    X}
    X
    Xusage() {
    X        fprintf(stderr, "Usage: m4 [-Dname[=val]] [-Uname]\n");
    X        exit(1);
    X}
    X
    X#ifdef GETOPT
    X/*
    X * H. Spencer getopt - get option letter from argv
    X *
    X *
    X#include <stdio.h>
    X *
    X */
    X
    Xchar    *optarg;    /* Global argument pointer. */
    Xint    optind = 0;    /* Global argv index. */
    X
    Xstatic char    *scan = NULL;    /* Private scan pointer. */
    X
    Xextern char    *index();
    X
    Xint
    Xgetopt(argc, argv, optstring)
    Xint argc;
    Xchar *argv[];
    Xchar *optstring;
    X{
    X    register char c;
    X    register char *place;
    X
    X    optarg = NULL;
    X
    X    if (scan == NULL || *scan == '\0') {
    X        if (optind == 0)
    X            optind++;
    X
    X        if (optind >= argc || argv[optind][0] != '-' || argv[optind][1] == '\0')
    X            return(EOF);
    X        if (strcmp(argv[optind], "--")==0) {
    X            optind++;
    X            return(EOF);
    X        }
    X
    X        scan = argv[optind]+1;
    X        optind++;
    X    }
    X
    X    c = *scan++;
    X    place = index(optstring, c);
    X
    X    if (place == NULL || c == ':') {
    X        fprintf(stderr, "%s: unknown option -%c\n", argv[0], c);
    X        return('?');
    X    }
    X
    X    place++;
    X    if (*place == ':') {
    X        if (*scan != '\0') {
    X            optarg = scan;
    X            scan = NULL;
    X        } else {
    X            optarg = argv[optind];
    X            optind++;
    X        }
    X    }
    X
    X    return(c);
    X}
    X
    X#endif
    X
    X#ifdef DUFFCP
    X/*
    X * This code uses Duff's Device (tm Tom Duff)
    X * to unroll the copying loop:
    X * while (count-- > 0)
    X *    *to++ = *from++;
    X */
    X
    X#define COPYBYTE     *to++ = *from++
    X
    Xmemcpy(to, from, count)
    Xregister char *from, *to;
    Xregister int count;
    X{
    X    if (count > 0) {
    X        register int loops = (count+8-1) >> 3;    /* div 8 round up */
    X
    X        switch (count&(8-1)) {            /* mod 8 */
    X        case 0: do {
    X            COPYBYTE;
    X        case 7:    COPYBYTE;
    X        case 6:    COPYBYTE;
    X        case 5:    COPYBYTE;
    X        case 4:    COPYBYTE;
    X        case 3:    COPYBYTE;
    X        case 2:    COPYBYTE;
    X        case 1:    COPYBYTE;
    X            } while (--loops > 0);
    X        }
    X
    X    }
    X}
    X
    X#endif
SHAR_EOF
if test 5005 -ne "`wc -c < 'misc.c'`"
then
    echo shar: error transmitting "'misc.c'" '(should have been 5005 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'expr.c'" '(11531 characters)'
if test -f 'expr.c'
then
    echo shar: will not over-write existing file "'expr.c'"
else
sed 's/^    X//' << \SHAR_EOF > 'expr.c'
    X
    X/*
    X *      expression evaluator: performs a standard recursive
    X *      descent parse to evaluate any expression permissible
    X *      within the following grammar:
    X *
    X *      expr    :       query EOS
    X *      query   :       lor
    X *              |       lor "?" query ":" query
    X *      lor     :       land { "||" land }
    X *      land    :       bor { "&&" bor }
    X *      bor     :       bxor { "|" bxor }
    X *      bxor    :       band { "^" band }
    X *      band    :       eql { "&" eql }
    X *      eql     :       relat { eqrel relat }
    X *      relat   :       shift { rel shift }
    X *      shift   :       primary { shop primary }
    X *      primary :       term { addop term }
    X *      term    :       unary { mulop unary }
    X *      unary   :       factor
    X *              |       unop unary
    X *      factor  :       constant
    X *              |       "(" query ")"
    X *      constant:       num
    X *              |       "'" CHAR "'"
    X *      num     :       DIGIT
    X *              |       DIGIT num
    X *      shop    :       "<<"
    X *              |       ">>"
    X *      eqlrel  :       "="
    X *              |       "=="
    X *              |       "!="
    X *      rel     :       "<"
    X *              |       ">"
    X *              |       "<="
    X *              |       ">="
    X *
    X *
    X *      This expression evaluator is lifted from a public-domain
    X *      C Pre-Processor included with the DECUS C Compiler distribution.
    X *      It is hacked somewhat to be suitable for m4.
    X *
    X *      Originally by:  Mike Lutz
    X *                      Bob Harper
    X */
    X
    X#define TRUE    1
    X#define FALSE   0
    X#define EOS     (char) 0
    X#define EQL     0
    X#define NEQ     1
    X#define LSS     2
    X#define LEQ     3
    X#define GTR     4
    X#define GEQ     5
    X#define OCTAL   8
    X#define DECIMAL 10
    X
    Xstatic char *nxtch;     /* Parser scan pointer */
    X
    X/*
    X * For longjmp
    X */
    X#include <setjmp.h>
    Xstatic jmp_buf  expjump;
    X
    X/*
    X * macros:
    X *
    X *      ungetch - Put back the last character examined.
    X *      getch   - return the next character from expr string.
    X */
    X#define ungetch()       nxtch--
    X#define getch()         *nxtch++
    X
    Xexpr(expbuf)
    Xchar *expbuf;
    X{
    X        register int rval;
    X
    X        nxtch = expbuf;
    X        if (setjmp(expjump) != 0)
    X                return (FALSE);
    X        rval = query();
    X        if (skipws() == EOS)
    X                return(rval);
    X        experr("Ill-formed expression");
    X}
    X
    X/*
    X * query : lor | lor '?' query ':' query
    X *
    X */
    Xquery()
    X{
    X        register int bool, true_val, false_val;
    X
    X        bool = lor();
    X        if (skipws() != '?') {
    X                ungetch();
    X                return(bool);
    X        }
    X
    X        true_val = query();
    X        if (skipws() != ':')
    X                experr("Bad query");
    X
    X        false_val = query();
    X        return(bool ? true_val : false_val);
    X}
    X
    X/*
    X * lor : land { '||' land }
    X *
    X */
    Xlor()
    X{
    X        register int c, vl, vr;
    X
    X        vl = land();
    X        while ((c = skipws()) == '|' && getch() == '|') {
    X                vr = land();
    X                vl = vl || vr;
    X        }
    X
    X        if (c == '|')
    X                ungetch();
    X        ungetch();
    X        return(vl);
    X}
    X
    X/*
    X * land : bor { '&&' bor }
    X *
    X */
    Xland()
    X{
    X        register int c, vl, vr;
    X
    X        vl = bor();
    X        while ((c = skipws()) == '&' && getch() == '&') {
    X                vr = bor();
    X                vl = vl && vr;
    X        }
    X
    X        if (c == '&')
    X                ungetch();
    X        ungetch();
    X        return(vl);
    X}
    X
    X/*
    X * bor : bxor { '|' bxor }
    X *
    X */
    Xbor()
    X{
    X        register int vl, vr, c;
    X
    X        vl = bxor();
    X        while ((c = skipws()) == '|' && getch() != '|') {
    X                ungetch();
    X                vr = bxor();
    X                vl |= vr;
    X        }
    X
    X        if (c == '|')
    X                ungetch();
    X        ungetch();
    X        return(vl);
    X}
    X
    X/*
    X * bxor : band { '^' band }
    X *
    X */
    Xbxor()
    X{
    X        register int vl, vr;
    X
    X        vl = band();
    X        while (skipws() == '^') {
    X                vr = band();
    X                vl ^= vr;
    X        }
    X
    X        ungetch();
    X        return(vl);
    X}
    X
    X/*
    X * band : eql { '&' eql }
    X *
    X */
    Xband()
    X{
    X        register int vl, vr, c;
    X
    X        vl = eql();
    X        while ((c = skipws()) == '&' && getch() != '&') {
    X                ungetch();
    X                vr = eql();
    X                vl &= vr;
    X        }
    X
    X        if (c == '&')
    X                ungetch();
    X        ungetch();
    X        return(vl);
    X}
    X
    X/*
    X * eql : relat { eqrel relat }
    X *
    X */
    Xeql()
    X{
    X        register int vl, vr, rel;
    X
    X        vl = relat();
    X        while ((rel = geteql()) != -1) {
    X                vr = relat();
    X
    X                switch (rel) {
    X
    X                case EQL:
    X                        vl = (vl == vr);
    X                        break;
    X                case NEQ:
    X                        vl = (vl != vr);
    X                        break;
    X                }
    X        }
    X        return(vl);
    X}
    X
    X/*
    X * relat : shift { rel shift }
    X *
    X */
    Xrelat()
    X{
    X        register int vl, vr, rel;
    X
    X        vl = shift();
    X        while ((rel = getrel()) != -1) {
    X
    X                vr = shift();
    X                switch (rel) {
    X
    X                case LEQ:
    X                        vl = (vl <= vr);
    X                        break;
    X                case LSS:
    X                        vl = (vl < vr);
    X                        break;
    X                case GTR:
    X                        vl = (vl > vr);
    X                        break;
    X                case GEQ:
    X                        vl = (vl >= vr);
    X                        break;
    X                }
    X        }
    X        return(vl);
    X}
    X
    X/*
    X * shift : primary { shop primary }
    X *
    X */
    Xshift()
    X{
    X        register int vl, vr, c;
    X
    X        vl = primary();
    X        while (((c = skipws()) == '<' || c == '>') && c == getch()) {
    X                vr = primary();
    X
    X                if (c == '<')
    X                        vl <<= vr;
    X                else
    X                        vl >>= vr;
    X        }
    X
    X        if (c == '<' || c == '>')
    X                ungetch();
    X        ungetch();
    X        return(vl);
    X}
    X
    X/*
    X * primary : term { addop term }
    X *
    X */
    Xprimary()
    X{
    X        register int c, vl, vr;
    X
    X        vl = term();
    X        while ((c = skipws()) == '+' || c == '-') {
    X                vr = term();
    X                if (c == '+')
    X                        vl += vr;
    X                else
    X                        vl -= vr;
    X        }
    X
    X        ungetch();
    X        return(vl);
    X}
    X
    X/*
    X * <term> := <unary> { <mulop> <unary> }
    X *
    X */
    Xterm()
    X{
    X        register int c, vl, vr;
    X
    X        vl = unary();
    X        while ((c = skipws()) == '*' || c == '/' || c == '%') {
    X                vr = unary();
    X
    X                switch (c) {
    X                case '*':
    X                        vl *= vr;
    X                        break;
    X                case '/':
    X                        vl /= vr;
    X                        break;
    X                case '%':
    X                        vl %= vr;
    X                        break;
    X                }
    X        }
    X        ungetch();
    X        return(vl);
    X}
    X
    X/*
    X * unary : factor | unop unary
    X *
    X */
    Xunary()
    X{
    X        register int val, c;
    X
    X        if ((c = skipws()) == '!' || c == '~' || c == '-') {
    X                val = unary();
    X
    X                switch (c) {
    X                case '!':
    X                        return(! val);
    X                case '~':
    X                        return(~ val);
    X                case '-':
    X                        return(- val);
    X                }
    X        }
    X
    X        ungetch();
    X        return(factor());
    X}
    X
    X/*
    X * factor : constant | '(' query ')'
    X *
    X */
    Xfactor()
    X{
    X        register int val;
    X
    X        if (skipws() == '(') {
    X                val = query();
    X                if (skipws() != ')')
    X                        experr("Bad factor");
    X                return(val);
    X        }
    X
    X        ungetch();
    X        return(constant());
    X}
    X
    X/*
    X * constant: num | 'char'
    X *
    X */
    Xconstant()
    X{
    X        /*
    X         * Note: constant() handles multi-byte constants
    X         */
    X
    X        register int    i;
    X        register int    value;
    X        register char   c;
    X        int             v[sizeof (int)];
    X
    X        if (skipws() != '\'') {
    X                ungetch();
    X                return(num());
    X        }
    X        for (i = 0; i < sizeof(int); i++) {
    X                if ((c = getch()) == '\'') {
    X                        ungetch();
    X                        break;
    X                }
    X                if (c == '\\') {
    X                        switch (c = getch()) {
    X                        case '0':
    X                        case '1':
    X                        case '2':
    X                        case '3':
    X                        case '4':
    X                        case '5':
    X                        case '6':
    X                        case '7':
    X                                ungetch();
    X                                c = num();
    X                                break;
    X                        case 'n':
    X                                c = 012;
    X                                break;
    X                        case 'r':
    X                                c = 015;
    X                                break;
    X                        case 't':
    X                                c = 011;
    X                                break;
    X                        case 'b':
    X                                c = 010;
    X                                break;
    X                        case 'f':
    X                                c = 014;
    X                                break;
    X                        }
    X                }
    X                v[i] = c;
    X        }
    X        if (i == 0 || getch() != '\'')
    X                experr("Illegal character constant");
    X        for (value = 0; --i >= 0;) {
    X                value <<= 8;
    X                value += v[i];
    X        }
    X        return(value);
    X}
    X
    X/*
    X * num : digit | num digit
    X *
    X */
    Xnum()
    X{
    X        register int rval, c, base;
    X        int ndig;
    X
    X        base = ((c = skipws()) == '0') ? OCTAL : DECIMAL;
    X        rval = 0;
    X        ndig = 0;
    X        while (c >= '0' && c <= (base == OCTAL ? '7' : '9')) {
    X                rval *= base;
    X                rval += (c - '0');
    X                c = getch();
    X                ndig++;
    X        }
    X        ungetch();
    X        if (ndig)
    X                return(rval);
    X        experr("Bad constant");
    X}
    X
    X/*
    X * eqlrel : '=' | '==' | '!='
    X *
    X */
    Xgeteql()
    X{
    X        register int c1, c2;
    X
    X        c1 = skipws();
    X        c2 = getch();
    X
    X        switch (c1) {
    X
    X        case '=':
    X                if (c2 != '=')
    X                        ungetch();
    X                return(EQL);
    X
    X        case '!':
    X                if (c2 == '=')
    X                        return(NEQ);
    X                ungetch();
    X                ungetch();
    X                return(-1);
    X
    X        default:
    X                ungetch();
    X                ungetch();
    X                return(-1);
    X        }
    X}
    X
    X/*
    X * rel : '<' | '>' | '<=' | '>='
    X *
    X */
    Xgetrel()
    X{
    X        register int c1, c2;
    X
    X        c1 = skipws();
    X        c2 = getch();
    X
    X        switch (c1) {
    X
    X        case '<':
    X                if (c2 == '=')
    X                        return(LEQ);
    X                ungetch();
    X                return(LSS);
    X
    X        case '>':
    X                if (c2 == '=')
    X                        return(GEQ);
    X                ungetch();
    X                return(GTR);
    X
    X        default:
    X                ungetch();
    X                ungetch();
    X                return(-1);
    X        }
    X}
    X
    X/*
    X * Skip over any white space and return terminating char.
    X */
    Xskipws()
    X{
    X        register char c;
    X
    X        while ((c = getch()) <= ' ' && c > EOS)
    X                ;
    X        return(c);
    X}
    X
    X/*
    X * Error handler - resets environment to eval(), prints an error,
    X * and returns FALSE.
    X */
    Xexperr(msg)
    Xchar *msg;
    X{
    X        printf("mp: %s\n",msg);
    X        longjmp(expjump, -1);          /* Force eval() to return FALSE */
    X}
SHAR_EOF
if test 11531 -ne "`wc -c < 'expr.c'`"
then
    echo shar: error transmitting "'expr.c'" '(should have been 11531 characters)'
fi
fi # end of overwriting check
#    End of shell archive
exit 0